package Doc; use LWP::UserAgent; use XML::LibXML; use XML::LibXSLT; use vars '$AUTOLOAD'; use Carp; use Data::Dumper; sub new { my ($class, %args) = @_; my $self = { docid => $args{docid}, url => $args{url}, xml => $args{xml}, body => $args{body}, head => $args{head}, full_html => $args{full_html}, domain_str => $args{domain_str}, local_domain => $args{local_domain}, audience => $args{audience}, domain_class => $args{domain_class}, password => $args{password}, user => $args{user}, rest_server => $args{rest_server}, xml_dir => $args{xml_dir}, html_dir => $args{html_dir}, list_file => $args{list_file}, }; bless $self, $class; return $self; } sub make_url { my $self = shift; my $url = 'http://' . $self->get_user . ':' . $self->get_password . '@' . $self->get_rest_server . '//document/' . $self->get_audience . '/' . $self->get_docid. '.xml' . $self->get_domain_str; $self->set_url($url); } sub make_preview_url { my $self = shift; my $url = 'http://' . $self->get_user . ':' . $self->get_password . '@' . $self->get_rest_server . '//preview/' . $self->get_audience . '/' . $self->get_docid. '.xml' . $self->get_domain_str; $self->set_url($url); } sub retrieve_document { my $self = shift; my $client = LWP::UserAgent->new(); my $request = HTTP::Request->new(GET => $self->get_url); my $result = $client->request($request); if (!$result->is_success()) { die "Could not retrieve document $self->get_docid: " . $result->status_line() . "\n"; } $self->set_xml($result->content()); } sub wrap_document { my $self = shift; my $parser = XML::LibXML->new(); my $document_xml; eval { $document_xml = $parser->parse_string($self->get_xml); }; if ($@) { croak "Could not parse document XML for $self->get_docid: $@"; return undef; } $self->set_xml($document_xml); $self->check_for_rest_error; } sub check_for_rest_error { my $self = shift; my $root_node = $self->get_xml->documentElement(); if (!$root_node) { croak "Could not find root node in doc from $self->get_docid"; return undef; } if ($root_node->nodeName() eq "kberror") { my $error_class = $root_node->findvalue("/kberror/exception"); my $error_message = $root_node->findvalue("/kberror/message"); croak "REST server error for document ". $self->get_docid.": $error_message"; return undef; } return 1; } sub create_tar_gz { my ($class, $target_dir,$files) = @_; my $tarball_name = $target_dir . '/sakai_help_docs.tar.gz'; `tar zcf -f $tarball_name $target_dir`; } # render_doc puts the head and body together # with the correct HTML glue tags and style info sub make_full_html { my ($self,$css_links) = @_; my $html = ' '; $html .= $self->get_head; for (@$css_links) { $html .= " "; } $html .= " "; $html .= $self->get_body; $html .= '

'; $html .= ' '; $self->set_full_html($html); } sub save { my ($self, $file_name, $text) = @_; open TODISK, ">$file_name" || croak "Couldn't open file '$file_name' for writing: $!"; if (-w $file_name) { print TODISK $text; } else { croak "Couldn't write document to file '$file_name'"; } close TODISK; } sub load { my ($self, $file_name) = @_; open FROMDISK, "$file_name" || croak "Couldn't open file '$file_name' for reading: $!"; my $text; if (-r $file_name) { $text .= $_ while ; } else { croak "Couldn't read from file '$file_name'"; } close FROMDISK; return $text; } # _transform does the actual applying of XSLT stylesheets to XML # documents. sub _transform { my ($self, $xsl_file, $xsl_params, $toString) = @_; my $parser = XML::LibXML->new(); my $xslt_parser = XML::LibXSLT->new(); my $xsl_doc = $parser->parse_file($xsl_file); my $stylesheet = $xslt_parser->parse_stylesheet($xsl_doc); my $transformed; eval { $transformed = $stylesheet->transform($self->get_xml, %$xsl_params); }; if ($@) { croak "Could not parse XML for document ". $self->get_docid.": $@"; } if ($toString) { return $stylesheet->output_string($transformed); } return $transformed; } sub render_body { my ($self, $xsl_file, $xsl_params) = @_; my $body_html = $self->_transform($xsl_file, $xsl_params, 'yes'); $self->set_body($body_html); } sub render_head { my ($self, $xsl_file, $xsl_params) = @_; my $head_html = $self->_transform($xsl_file, $xsl_params, 'yes'); $self->set_head($head_html); } sub preprocess { my ($self, $xsl_file) = @_; my $transformed = $self->_transform($xsl_file); $self->set_xml($transformed); } sub update_ignored_list { my $self = shift; } #class methods sub DESTROY{}; sub AUTOLOAD { # see Conway, Object Oriented Perl, p. 93 on smart AUTOLOAD methods no strict "refs"; my ($self, $newval) = @_; # Was it a get_... method? if ($AUTOLOAD =~ /.*::get_(\w+)/) { my $attr_name = $1; *{$AUTOLOAD} = sub {return $_[0]->{$attr_name} }; return $self->{$attr_name}; } # Was it a set_... method? elsif ($AUTOLOAD =~ /.*::set_(\w+)/) { my $attr_name = $1; *{$AUTOLOAD} = sub { $_[0]->{$attr_name} = $_[1]; return}; $self->{$1} = $newval; return; } croak "No such method: $AUTOLOAD"; } 1;