The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
##
## WWW::YouTube::HTML::API
##
package WWW::YouTube::HTML::API;

use strict;

use warnings;

#program version
#my $VERSION="0.1";

#For CVS , use following line
our $VERSION=sprintf("%d.%04d", q$Revision: 2008.0728 $ =~ /(\d+)\.(\d+)/);

BEGIN {

   require Exporter;

   @WWW::YouTube::HTML::API::ISA = qw(Exporter);

   @WWW::YouTube::HTML::API::EXPORT = qw(); ## export required

   @WWW::YouTube::HTML::API::EXPORT_OK =
   (
   ); ## export ok on request

   $WWW::YouTube::HTML::API::url = 'http://www.youtube.com';

} ## end BEGIN

require WWW::YouTube::ML::API; ## NOTE: generic *ML

require LWP::UserAgent; ## HTML::API::ua (User Agent)

require LWP::Simple; ## HTML::API::ua-like (Simple User Agent)

require HTTP::Cookies;

require HTTP::Request::Common; ## qw(POST); ## quick and easy POST edit

require HTML::TreeBuilder; ## HTML::API::tree parser

require Data::Dumper;

require IO::File;

require Encode;

require FindBin;

require File::Basename;

require File::Spec;

__PACKAGE__ =~ m/^(WWW::[^:]+)::([^:]+)(::([^:]+)){0,1}$/g;

##debug##print( "API! $1::$2::$4\n" );

%WWW::YouTube::HTML::API::opts_type_args =
(
   'ido'            => $1,
   'iknow'          => $2,
   'iman'           => $4,
   'myp'            => __PACKAGE__,
   'opts'           => {},
   'opts_filename'  => {},
   'export_ok'      => [],
   'opts_type_flag' =>
   [
      @{$WWW::YouTube::ML::API::opts_type_args{'opts_type_flag'}},
   ],
   'opts_type_numeric' =>
   [
      @{$WWW::YouTube::ML::API::opts_type_args{'opts_type_numeric'}},
   ],
   'opts_type_string' =>
   [
      @{$WWW::YouTube::ML::API::opts_type_args{'opts_type_string'}},
   ],

);

die( __PACKAGE__ ) if (
     __PACKAGE__ ne join( '::', $WWW::YouTube::HTML::API::opts_type_args{'ido'},
                                $WWW::YouTube::HTML::API::opts_type_args{'iknow'},
                                $WWW::YouTube::HTML::API::opts_type_args{'iman'}
                        )
                      );

WWW::YouTube::ML::API::create_opts_types( \%WWW::YouTube::HTML::API::opts_type_args );

$WWW::YouTube::HTML::API::numeric_max_try = $WWW::YouTube::ML::API::numeric_max_try;

WWW::YouTube::ML::API::register_all_opts( \%WWW::YouTube::HTML::API::opts_type_args );

push( @WWW::YouTube::HTML::API::EXPORT_OK,
      @{$WWW::YouTube::HTML::API::opts_type_args{'export_ok'}} );

#foreach my $x ( keys %{$WWW::YouTube::HTML::API::opts_type_args{'opts'}} )
#{
#   printf( "opts{%s}=%s\n", $x, $WWW::YouTube::HTML::API::opts_type_args{'opts'}{$x} );
#} ## end foreach

#foreach my $x ( @{$WWW::YouTube::HTML::API::opts_type_args{'export_ok'}} )
#{
#   printf( "ok=%s\n", $x );
#} ## end foreach

#foreach my $x ( @WWW::YouTube::HTML::API::EXPORT_OK )
#{
#   printf( "OK=%s\n", $x );
#} ## end foreach

##
## NOTE: Getopts hasn't set the options yet. (all flags = 0 right now)
##

$WWW::YouTube::HTML::API::cookie_file = undef;

$WWW::YouTube::HTML::API::cookies = undef;

$WWW::YouTube::HTML::API::ua = undef;

$WWW::YouTube::HTML::API::request = undef;

$WWW::YouTube::HTML::API::result = undef; ## HTTP::Response

$WWW::YouTube::HTML::API::tree = HTML::TreeBuilder->new();            ## need one to work with
$WWW::YouTube::HTML::API::tree = $WWW::YouTube::HTML::API::tree->delete(); ## after each use to clean up

%WWW::YouTube::HTML::API::vlmr = (); ## youtube.videos.list_most_recent

END {

} ## end END

##
## get_started
##
sub get_started
{
   $WWW::YouTube::HTML::API::cookie_file = File::Spec->catfile( $FindBin::Bin,
                                                'lwpcookies_' . $WWW::YouTube::Com::user . '.txt'
                                                              );

   $WWW::YouTube::HTML::API::cookies =
      HTTP::Cookies->new( 'file' => $WWW::YouTube::HTML::API::cookie_file,
                          'autosave' => 1
                        );

   $WWW::YouTube::HTML::API::ua = LWP::UserAgent->new(
                                'cookie_jar' => $WWW::YouTube::HTML::API::cookies,
                                'protocols_allowed'   => [ 'http', 'https' ],
                                'protocols_forbidden' => [ 'ftp', 'mailto' ],
                                                     );

   if ( ! -f $WWW::YouTube::HTML::API::cookie_file )
   {
      my $ua_info = 'sprintf( "WWW::YouTube::HTML::API login failed: %s \$itry=%dof%d\n",
                              $result->status_line(), $itry-1, $max_try
                            )';

      my $request_uri = "$WWW::YouTube::HTML::API::url/login";

      my %request_form =
      (
         'current_form' => 'loginForm',
         'username' => $WWW::YouTube::Com::user,
         'password' => $WWW::YouTube::Com::pass,
         'action_login' => 'Log In',
      );

      my $request = HTTP::Request::Common::POST( $request_uri, \%request_form );

      my $result = undef;

      my ( $itry, $max_try ) = ( 1, $WWW::YouTube::HTML::API::numeric_max_try );

      push( @{ $WWW::YouTube::HTML::API::ua->requests_redirectable }, 'POST' ); ## "HTTP 303 See Other"

      while ( $itry++ <= $max_try )
      {
         $result = $WWW::YouTube::HTML::API::ua->get( $request_uri );

         sleep 5; ## I'm, like, a human?

         $result = $WWW::YouTube::HTML::API::ua->request( $request );

         last if ( $result->is_success() );

         print( STDERR eval( $ua_info ) ) if ( $itry > $max_try );

      } ## end while

      pop( @{ $WWW::YouTube::HTML::API::ua->requests_redirectable } );

      ##
      ## Simulating the Frontier::Client debug output style of XML::API::ua
      ##
      if ( $WWW::YouTube::HTML::API::flag_ua_dmp )
      {
         printf( STDERR "---- request ----\n%s\n", $request->as_string() );

         printf( STDERR "---- result  ----\n%s\n", $result->as_string() );

      } ## end if

   } ## end if

} ## end sub get_started

##
## WWW::YouTube::HTML::API::show_all_opts
##
sub WWW::YouTube::HTML::API::show_all_opts
{
   WWW::YouTube::ML::API::show_all_opts( \%WWW::YouTube::HTML::API::opts_type_args );

} ## end sub WWW::YouTube::HTML::API::show_all_opts

##
## WWW::YouTube::HTML::API::mirror
##
sub mirror
{
   my ( $uri, $localfile ) = @_;

   get_started() if ( ! defined( $WWW::YouTube::HTML::API::ua ) );

   $WWW::YouTube::HTML::API::ua->mirror( $uri, $localfile );

} ## end sub mirror

##
## WWW::YouTube::HTML::API::ua_request
##
## returns a parse $tree and the $result (delete your $tree when you're done with it!)
##
sub WWW::YouTube::HTML::API::ua_request
{
   my ( $request, $control ) = @_;

   my $result = undef;

   my $tree = undef;

   my $ua_info = 'sprintf( "WWW::YouTube::HTML::API::ua_request failed: %s \$itry=%dof%d\n",
                            $result->status_line(), $itry-1, $max_try
                         )';

   my ( $itry, $max_try ) = ( 1, $WWW::YouTube::HTML::API::numeric_max_try );

   get_started() if ( ! defined( $WWW::YouTube::HTML::API::ua ) );

   while ( $itry++ <= $max_try )
   {
      $result = $WWW::YouTube::HTML::API::ua->request( $request );

      last if ( $result->is_success() );

      print( STDERR eval( $ua_info ) ) if ( $itry > $max_try );

   } ## end while

   ##
   ## Simulating the Frontier::Client debug output style of XML::API::ua
   ##
   if ( $WWW::YouTube::HTML::API::flag_ua_dmp )
   {
      printf( STDERR "---- request ----\n%s\n", $request->as_string() );

      printf( STDERR "---- result  ----\n%s\n", $result->as_string() );

   } ## end if

   if ( $result->is_success() )
   {
      ##debug##      print( STDERR "ua_request got good result\n" );

      return ( $result ) if ( defined( $control->{'no_tree'} ) );

      $tree = HTML::TreeBuilder->new(); ## (delete your $tree when you're done with it!)

      $tree->parse( $result );

      $tree->eof();

      $tree->elementify(); ## NOTE: maybe I shouldn't do this all the time here?

      return ( $tree ) if ( defined( $control->{'no_result'} ) );

   }
   else
   {
      die eval( $ua_info );

   } ## end if

   return ( $tree, $result ); ## you get to pick one or keep both

} ## end sub WWW::YouTube::HTML::API::ua_request

1;
__END__ ## package WWW::YouTube::HTML::API

=head1 NAME

WWW::YouTube::HTML::API - How to Interface with YouTube using HTTP Protocol, CGI, returning HTML.

=head1 SYNOPSIS

=head1 OPTIONS

--html_api_* options:

opts_type_flag:

   --html_api_ua_dmp
   --html_api_request_dmp
   --html_api_result_dmp

opts_type_numeric:

   --html_api_max_try=number

opts_type_string:

   NONE

=head1 DESCRIPTION

HTML::API stands for HTML Application Programming Interface

=head1 SEE ALSO

I<L<WWW::YouTube>> I<L<WWW::YouTube::ML::API>> I<L<WWW::YouTube::HTML>> I<L<WWW::YouTube::XML::API>>

=head1 AUTHOR

 Copyright (C) 2008 Eric R. Meyers E<lt>Eric.R.Meyers@gmail.comE<gt>

=cut